home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / SystemCode / modes.tcl < prev    next >
Encoding:
Text File  |  1994-09-21  |  18.9 KB  |  726 lines  |  [TEXT/ALFA]
  1. # New modes can be specified by appending to the following vars.
  2. # are no longer any procs such as 'setTextMode' etc.
  3.  
  4. # 'mode' is nothing when we start up.
  5. set mode ""
  6.  
  7. set whichInfo mode
  8.  
  9. #================================================================================
  10. # The next two procs are called by Alpha to handle the mode flags popup menu.
  11. #================================================================================
  12.  
  13. proc getModeValuesAlpha {} {
  14.     global mode
  15.     global ${mode}modeVars
  16.     global allFlags
  17.     global whichInfo
  18.     set fvals {}
  19.     set vvals {}
  20.  
  21.     if {$whichInfo == "mode"} {
  22.         if {[info exists ${mode}modeVars]} {
  23.             set vars [lsort [array names ${mode}modeVars]]
  24.             foreach v $vars {
  25.                 if {[lsearch $allFlags $v] >= 0} {
  26.                     lappend fvals $v [set ${mode}modeVars($v)]
  27.                 } else {
  28.                     lappend vvals $v 0
  29.                 }
  30.             }
  31.         }
  32.         return [concat $fvals {-} 0 $vvals {{(-} 0 "Set Mode Menus…" 0 "Change Mode Vars…" 0 "Describe Mode" 0 {(-} 0 "(Mode Info" 0 "File Info" 0}]
  33.     } else {
  34.         getWinInfo blah
  35.         lappend m "Mac" [expr {$blah(platform) == "mac"}]
  36.         lappend m "UNIX" [expr {$blah(platform) == "unix"}]
  37.         lappend m "IBM" [expr {$blah(platform) == "ibm"}] {(-} 0
  38.         lappend m "MPW" [expr {$blah(state) == "mpw"}]
  39.         lappend m "Think" [expr {$blah(state) == "think"}]
  40.         lappend m "None" [expr {$blah(state) == "none"}] {(-} 0
  41.         lappend m "Read Only" $blah(read-only) {(-} 0
  42.         lappend m "Tab Size" 0 {(-} 0
  43.         lappend m "Mode Info" 0 "(File Info" 0
  44.         return $m
  45.     }
  46. }
  47.  
  48.  
  49. proc setModeVarAlpha {var} {
  50.     global mode allFlags modeVars modifiedModeVars
  51.     global whichInfo
  52.     global ${mode}modeVars
  53.     
  54.     if {$whichInfo == "file"} {
  55.         set var [string tolower $var]
  56.         switch $var {
  57.             "unix"        -
  58.             "mac"        -
  59.             "ibm"        { setWinInfo platform $var }
  60.             "mpw"        -
  61.             "think"        -
  62.             "none"        { setWinInfo state $var }
  63.             "mode info"    { set whichInfo mode }
  64.             "tab size"  {
  65.                 getWinInfo arr
  66.                 if {![catch {prompt "New tab size?" $arr(tabsize)} res]} {
  67.                     setWinInfo tabsize $res
  68.                 }
  69.             }
  70.             "read only"    { 
  71.                 getWinInfo b
  72.                 setWinInfo read-only [expr -1 * ($b(read-only) - 1)]}
  73.         }
  74.         return
  75.     }
  76.             
  77.     if {$var == "Set Mode Menus…"} {
  78.         setModeMenus
  79.     } elseif {$var == "File Info"} {
  80.         set whichInfo file
  81.     } elseif {$var == "Mode Info"} {
  82.         set whichInfo mode
  83.     } elseif {$var == "Change Mode Vars…"} {
  84.         set mvars {}
  85.         catch {set mvars [array names ${mode}modeVars]}
  86.         set vars [listpick -l -L $mvars -p "Set mode vars for '$mode':" [lsort $modeVars]]
  87.         if {![string length $vars]} return
  88.         
  89.         catch {unset ${mode}modeVars}
  90.         foreach v $vars {
  91.             global $v
  92.             set ${mode}modeVars($v) [set $v]
  93.         }
  94.     } elseif {$var == "Describe Mode"} {
  95.         describeMode
  96.     } elseif {[lsearch $allFlags $var] >= 0} {
  97.         global $var
  98.         set ${mode}modeVars($var) [set $var [expr -1 * ([set ${mode}modeVars($var)] - 1)]]
  99.         lappend modifiedModeVars [list $var ${mode}modeVars]
  100.     } else {
  101.         global $var
  102.         set res [prompt "New value of '$var':" [set ${mode}modeVars($var)]]
  103.         set ${mode}modeVars($var) $res
  104.         set $var $res
  105.         lappend modifiedModeVars [list $var ${mode}modeVars]
  106.     }
  107. }
  108.  
  109. #================================================================================
  110.  
  111.  
  112. # Suffixes used to initially determine mode for new window.
  113. set modeSuffixes { default { set winMode Text } }
  114.  
  115.  
  116. # The set of menus that the modes may choose to use.
  117. set allModeMenus {     thinkMenu cwarrierMenu toolserverMenu
  118.                     latexMenu thinkRefMenu tclMenu perlMenu }
  119.  
  120. set modeVars { elecLBrace elecRBrace electricSemi fillColumn funcExpr 
  121.     funcPar optionIsMeta prefixString suffixString leftFillColumn
  122.     tabSize wordBreak wordBreakPreface wordWrap
  123. }
  124.  
  125.  
  126. # The dummy proc for a mode is called whenever we change to that mode,
  127. # so that the autoloading facility will load the correct file, if
  128. # necessary.
  129.  
  130. # The list of modes.
  131. set modes         {}
  132. set lastMode     0
  133.  
  134. # Can be used to add new mode-specific flags and variables (see think.tcl for example).
  135. proc newModeVar {mode var val isFlag} {
  136.     global ${mode}modeVars modeVars allFlags $var
  137.     
  138.     if {![info exists modeVars] || [lsearch $modeVars $var] < 0} {
  139.         lappend modeVars $var
  140.     }
  141.     if {![info exists ${mode}modeVars($var)]} {
  142.         set ${mode}modeVars($var) $val
  143.         set $var $val
  144.     }
  145.     if {$isFlag && (![info exists allFlags] || ([lsearch $allFlags $var] < 0))} {
  146.         lappend allFlags $var
  147.     }
  148. }
  149.  
  150. #================================================================================
  151. lappend modes C
  152. set dummyProc(C)                dummyC
  153. set modeMenus(C)                 { thinkMenu cwarrierMenu thinkRefMenu }
  154. lappend modeSuffixes             {*.h} { set winMode C }
  155. lappend modeSuffixes            {*.c} { set winMode C }
  156. lappend modeSuffixes            {*.r} { set winMode C }
  157. newModeVar C elecRBrace {1} 1
  158. newModeVar C leftFillColumn {3} 0
  159. newModeVar C prefixString {//} 0 
  160. newModeVar C electricSemi {1} 1
  161. newModeVar C wordBreak {[a-zA-Z0-9_]+} 0
  162. newModeVar C elecLBrace {1} 1
  163. newModeVar C wordWrap {0} 1
  164. newModeVar C funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  165. newModeVar C wordBreakPreface {[^a-zA-Z0-9_]} 0
  166. newModeVar C optionIsMeta {1} 1
  167. newModeVar C electricTab {0} 1
  168.  
  169. set cCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  170. set cPreRegexp        {^\#[\t ]*[a-z]*}
  171. set cKeyWords        {
  172.     void register short enum extern int for if while struct static long 
  173.     switch case char unsigned double float return else default goto
  174. }
  175. regModeKeywords -e {//} -b {/*} {*/} -c red -k blue C $cKeyWords
  176.  
  177. #================================================================================
  178. lappend modes C++
  179. set dummyProc(C++)                dummyC++
  180. set modeMenus(C++)                 { thinkMenu cwarrierMenu thinkRefMenu }
  181. lappend modeSuffixes             {*.h} { set winMode C++ }
  182. lappend modeSuffixes            {*.cc} { set winMode C++ }
  183. lappend modeSuffixes            {*.cp} { set winMode C++ }
  184. lappend modeSuffixes            {*.cpp} { set winMode C++ }
  185. lappend modeSuffixes            {*.CPP} { set winMode C++ }
  186. lappend modeSuffixes            {*.C} { set winMode C++ }
  187. newModeVar C++ elecRBrace {1} 1
  188. newModeVar C++ leftFillColumn {3} 0
  189. newModeVar C++ prefixString {//} 0
  190. newModeVar C++ electricSemi {1} 1
  191. newModeVar C++ wordBreak {[a-zA-Z0-9_]+} 0
  192. newModeVar C++ elecLBrace {1} 1
  193. newModeVar C++ wordWrap {0} 1
  194. newModeVar C++ funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  195. newModeVar C++ wordBreakPreface {[^a-zA-Z0-9_]} 0
  196. newModeVar C++ optionIsMeta {1} 1
  197. newModeVar C++ electricTab {1} 1
  198.  
  199. regModeKeywords -e {//} -b {/*} {*/} -c red -k blue {C++} [concat {
  200.     new delete class friend protected private public template } $cKeyWords]
  201. unset cKeyWords
  202.  
  203. #================================================================================
  204. lappend modes Csh
  205. set dummyProc(Csh)                dummyCsh
  206. set modeMenus(Csh)             { tclMenu }
  207. lappend modeSuffixes            {*tcl\ sh*} {set winMode Csh}
  208. newModeVar Csh wordBreak {(\$)?[a-zA-Z0-9_]+} 0
  209. newModeVar Csh wordWrap {0} 1
  210. newModeVar Csh wordBreakPreface {[^a-zA-Z0-9_\$]} 0
  211. newModeVar Csh optionIsMeta {1} 1
  212. regModeKeywords -m {«} Csh {}
  213.  
  214. #================================================================================
  215. lappend modes Text
  216. set modeMenus(Text)                { }
  217. newModeVar Text leftFillColumn {0} 0
  218. newModeVar Text suffixString { <--} 0
  219. newModeVar Text prefixString {> } 0
  220. newModeVar Text fillColumn {75} 0
  221. newModeVar Text wordWrap {1} 1
  222. newModeVar Text optionIsMeta {1} 1
  223.  
  224. #================================================================================
  225. # Updated Fortran mode definition:
  226. #
  227. # Changes are:    * .fcm suffix triggers Fort mode (CM-5 fortran)
  228. #                 * .for suffix triggers Fort mode (old compilers)
  229. #                * "entry" names are included in subroutine lists
  230. #                * prefix sting is set correctly (initial 'c')
  231. #                * FortMarkFile routine provided (funcExpr doesn't work anymore?)
  232. #
  233. # WTP 8/5/94
  234. #=============================================================================
  235. lappend modes Fort
  236. set modeMenus(Fort)             { }
  237. lappend modeSuffixes            {*.f} { set winMode Fort }
  238. lappend modeSuffixes            {*.fcm} { set winMode Fort }
  239. lappend modeSuffixes            {*.for} { set winMode Fort }
  240. lappend modeSuffixes            {*.FOR} { set winMode Fort }
  241. set FortmodeVars(wordWrap)        {0}
  242. set FortmodeVars(prefixString)    {c}
  243. set FortmodeVars(sortedIsDefault)        {0}
  244. set FortmodeVars(funcExpr)    {^[ \t]*(subroutine|.*function|entry|SUBROUTINE|.*FUNCTION|ENTRY).*\(.*$}
  245. set FortmodeVars(optionIsMeta)    {1}
  246.  
  247. set FortKeywords { 
  248.     backspace block call character close common complex 
  249.     continue data dimension do double else elseif end enddo endfile endif entry 
  250.     equivalence external format function goto if implicit inquire integer 
  251.     intrinsic logical open parameter precision print program read return save 
  252.     stop real rewind subroutine then write
  253. }
  254.  
  255. regModeKeywords -c red -k blue Fort $FortKeywords
  256. unset FortKeywords
  257.  
  258. #=============================================================================
  259.  
  260. proc FortMarkFile {} {
  261.     set pat1 {^[^cC][ \tA-Za-z*0-9]+(subroutine|function|entry)[ \t]*([A-Za-z0-9_]+)}
  262.     set end [maxPos]
  263.     set pos 0
  264.     set l {}
  265.     while {![catch {search -f 1 -r 1 -m 0 -i 1 $pat1 $pos} mtch]} {
  266.         regexp -nocase $pat1 [eval getText $mtch] allofit subtyp name
  267.         set start [lindex $mtch 0]
  268.         set end [nextLineStart $start]
  269.         set pos $end
  270.         set inds($name) [lineStart $start]
  271.     }
  272.  
  273.     if {[info exists inds]} {
  274.         foreach f [lsort [array names inds]] {
  275.             set next [nextLineStart $inds($f)]
  276.             setNamedMark $f $inds($f) $next $next
  277.         }
  278.     }
  279. }
  280.  
  281. #=============================================================================
  282. lappend modes Tcl
  283. set dummyProc(Tcl)                dummyTcl
  284. set modeMenus(Tcl)                 { tclMenu }
  285. lappend modeSuffixes            {*.tcl} { set winMode Tcl }
  286. newModeVar Tcl prefixString {# } 0
  287. newModeVar Tcl wordWrap {0} 1
  288. newModeVar Tcl funcExpr {^proc *([+-a-zA-Z0-9]+)} 0
  289. newModeVar Tcl wordBreak {(\$)?[a-zA-Z0-9_]+} 0
  290. newModeVar Tcl wordBreakPreface {([^a-zA-Z0-9_\$]|.\$)} 0
  291. newModeVar Tcl optionIsMeta {1} 1
  292. newModeVar Tcl electricTab {1} 1
  293.  
  294. set tclKeywords {
  295.     then append array break case catch cd close concat continue elseif else eof 
  296.     error eval exec exit expr file flush foreach format for gets global glob 
  297.     history if incr info join lappend library lindex linsert list llength 
  298.     lrange lreplace lsearch lsort open pid proc puts pwd read regexp regsub 
  299.     rename return scancontext scan seek set source split string switch tell 
  300.     time trace unknown unset uplevel upvar while
  301. }
  302. regModeKeywords -e {#} -c red -k blue Tcl $tclKeywords
  303. unset tclKeywords
  304.  
  305. #================================================================================
  306. lappend modes MPW
  307. set modeMenus(MPW)                 { }
  308. lappend modeSuffixes            {*Toolserver\ *} { set winMode MPW }
  309.  
  310. #================================================================================
  311. lappend modes Brws
  312. set modeMenus(Brws)             { }
  313. set dummyProc(Brws)                dummyBrws
  314. #================================================================================
  315. lappend modes Diff
  316. set modeMenus(Diff)             { }
  317. #================================================================================
  318.  
  319. proc buildFlagsVars {} {
  320.     global allFlags allVars modeVars
  321.     
  322.     set fs {}
  323.     foreach f [lsort $allFlags] {
  324.         if {[lsearch $modeVars $f] < 0} {
  325.             lappend fs $f
  326.         }
  327.     }
  328.     menu -m -n flags -p editFlag $fs
  329.     eval global $fs
  330.     foreach f $fs {
  331.         markMenuItem flags $f [set $f]
  332.     }
  333.  
  334.     set fs {}
  335.     foreach f [lsort $allVars] {
  336.         if {[lsearch $modeVars $f] < 0} {
  337.             lappend fs $f
  338.         }
  339.     }
  340.     menu -m -n vars -p editVar $fs
  341. }
  342.  
  343.  
  344. proc saveVarValues {} {
  345.     global modes HOME
  346.     if {[askyesno "Save variables and values to \"$HOME:alphaFlags.tcl\"?"] == "yes"} {
  347.         set lines {}
  348.         foreach m $modes {
  349.             global ${m}modeVars
  350.             
  351.             if {[info exists ${m}modeVars]} {
  352.                 foreach v [array names ${m}modeVars] {
  353.                     append lines "set ${m}modeVars($v)\t\t\{[set ${m}modeVars($v)]\}\r"
  354.                 }
  355.                 append lines "\r"
  356.             }
  357.         }
  358.         
  359.         append lines "\r\r"
  360.         global allFlags allVars
  361.         set vars [lsort [concat $allFlags $allVars]]
  362.         eval global $vars
  363.         foreach f $vars {
  364.             append lines "set $f\t\t\{[set $f]\}\r"
  365.         }
  366.  
  367.         set fd [open "$HOME:alphaFlags.tcl" "w"]
  368.         puts $fd $lines
  369.         close $fd
  370.         message "New '$HOME:alphaFlags.tcl' written."
  371.     }
  372. }
  373.  
  374.  
  375. #================================================================================
  376.  
  377. proc setWinMode name {
  378.     global winModes modeSuffixes
  379.     set nm [file tail $name]
  380.     if {[set first [string last " <" $nm]] >= 0} {
  381.         set rname [string range $nm 0 [expr $first - 1]]
  382.     } else {
  383.         set rname $nm
  384.     }
  385.     case $rname in $modeSuffixes
  386.     set winModes($name) $winMode
  387. }
  388.  
  389.  
  390.  
  391. proc newMode mode {
  392.     global winModes modeProcs
  393.     
  394.     set name [lindex [winNames -f] 0]
  395.     changeMode $mode
  396.     set winModes($name) $mode
  397. }
  398.  
  399.  
  400. proc deactivateHook name {
  401. }
  402.  
  403. proc suspendHook name {
  404.     global iconifyOnSwitch
  405.     global suspIconed
  406.     if {$iconifyOnSwitch} {
  407.         set wins [winNames -f]
  408.         foreach win $wins {
  409.             if {![icon -f "$win" -q]} {
  410.                 set suspIconed($win) 1
  411.                 icon -f "$win" -t
  412.             }
  413.         }
  414.     }
  415. }
  416.  
  417. proc resumeHook name {
  418.     global iconifyOnSwitch resumeRevert suspIconed
  419.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  420.         set wins [winNames -f]
  421.         foreach win [array names suspIconed] {
  422.             icon -f "$win" -o
  423.         }
  424.         unset suspIconed
  425.     }
  426.     if {$resumeRevert} {
  427.         set resumeRevert 0
  428.         revert
  429.     }
  430. }
  431.  
  432.  
  433.  
  434. # Handles dynamically adding and deleting window names from menu.
  435. proc addWinName name {
  436.     global winNameToNum winMenu winNumToName fullNames
  437.     
  438.     for {set i 0} {$i<100} {incr i} {
  439.         if {[catch {set nm $winNumToName($i)} res] == "1"} {
  440.             if {$fullNames != "0"} {
  441.                 set nm $name
  442.             } else {
  443.                 regexp {[^:]*$} $name nm
  444.             }
  445.             if {$i < 10} {
  446.                 addMenuItem -m -l "/$i" $winMenu $nm
  447.             } else {
  448.                 addMenuItem -m -l "" $winMenu $nm
  449.             }
  450.             set winNumToName($i) $name
  451.             set winNameToNum($name) $i
  452.             return
  453.         }
  454.     }
  455. }
  456.  
  457. proc removeWinName name {
  458.     global winNameToNum winNumToName fullNames winMenu
  459.     
  460.     set num $winNameToNum($name)
  461.     unset winNumToName($num)
  462.     unset winNameToNum($name)
  463.     if {$fullNames == "1"} {
  464.         deleteMenuItem -m $winMenu $name
  465.     } else {
  466.         regexp {[^:]*$} $name nm
  467.         deleteMenuItem -m $winMenu $nm
  468.     }
  469. }
  470.  
  471.  
  472. proc menuWin {menu name} {
  473.     global winNameToNum
  474.  
  475.     set nms [array names winNameToNum]
  476.     foreach nm $nms {
  477.         if {[string match *$name $nm] == "1"}  {
  478.             bringToFront $name
  479.             if [icon -q] { icon -f $name -o }
  480.             return
  481.         }
  482.     }
  483.     return "normal"
  484. }
  485.  
  486.  
  487.  
  488. proc changeMode {newMode} {
  489.     global lastMode modeMenus dummyProc mode
  490.     
  491.     catch {displayMode $newMode}
  492.     set lastMode $mode
  493.     set mode $newMode
  494.     if {$lastMode == $mode} return
  495.  
  496.     global ${mode}modeVars
  497.     if {[info exists ${mode}modeVars]} {
  498.         foreach v [array names ${mode}modeVars] {
  499.             global $v
  500.             set $v [set ${mode}modeVars($v)]
  501.         }
  502.     }
  503.  
  504.     if {[info exists dummyProc($mode)]} { $dummyProc($mode) }
  505.  
  506.     if {[info exists modeMenus($lastMode)]} {
  507.         foreach m $modeMenus($lastMode) {
  508.             global $m
  509.             catch {removeMenu [set $m]}
  510.         }
  511.     }
  512.     if {[info exists modeMenus($mode)]} {
  513.         foreach m $modeMenus($mode) {
  514.             global $m
  515.             catch {insertMenu [set $m]}
  516.         }
  517.     }
  518. }
  519.  
  520.  
  521. proc setModeMenus {} {
  522.     global mode modeMenus allModeMenus modifiedModeMenus
  523.  
  524.     set menus [listpick -p "Pick menus for mode '$mode':" -l -L $modeMenus($mode) [lsort $allModeMenus]]
  525.     if {![llength $menus]} return
  526.     set modeMenus($mode) $menus
  527.  
  528.     lappend modifiedModeMenus $mode
  529.  
  530.     foreach m $allModeMenus {
  531.         global $m
  532.         catch {removeMenu [set $m]}
  533.     }
  534.     foreach m $menus {
  535.         global $m
  536.         catch {insertMenu [set $m]}
  537.     }
  538. }
  539.  
  540.  
  541. #=============================================================================
  542. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  543. #                          "suspendHook", "saveasHook", "saveHook", and "resumeHook".
  544. #=============================================================================
  545.  
  546. if {![info exists winActive]} {set winActive ""}
  547.  
  548. # Event hooks - set specific modes when files opened.
  549. proc openHook name {
  550.     global winModes winActive
  551.     changeMode $winModes($name)
  552.     if {$name == {*Toolserver shell*}} startMPW
  553.     addWinName $name
  554.     message ""
  555. }
  556.  
  557.  
  558.  
  559. # full pathname
  560. proc saveHook name {
  561.     global backup backExtension backDir mode
  562.     
  563.     if {($mode == "C") || ($mode == "C++")} {catch {modified}}
  564.  
  565.     if ($backup) {
  566.         if {![string length [set dir $backDir]]} {
  567.             set dir [file dirname $name]
  568.         }
  569.         if {![file exists $dir]} {
  570.             if {[askyesno "Create backup dir '$dir'?"] == "yes"} {
  571.                 mkdir $dir
  572.             }
  573.         }
  574.         catch {rm $dir:[file tail $name]$backExtension}
  575.         catch {cp $name $dir:[file tail $name]$backExtension}
  576.     }
  577. }
  578.  
  579. # Clean up the mark stack.
  580. proc closeHook name {
  581.     global markStack winModes winActive
  582.  
  583.     unset winModes($name)
  584.     if [llength $markStack] {
  585.         set markStack [removePat $markStack $name*]
  586.     }
  587.     removeWinName $name
  588.  
  589.     if {[set ind [lsearch $winActive $name]] >= 0} {
  590.         set winActive [lreplace $winActive $ind $ind]
  591.     }
  592. }
  593.  
  594.  
  595. proc saveasHook {oldName newName} {
  596.     global winModes winActive
  597.     removeWinName $oldName
  598.     addWinName $newName
  599.     setWinMode $newName
  600.     changeMode $winModes($newName)
  601.     
  602.     if {[set ind [lsearch $winActive $oldName]] >= 0} {
  603.         set winActive [lreplace $winActive $ind $ind]
  604.     }
  605.     set winActive [linsert $winActive 0 $newName]
  606. }
  607.  
  608. if {![info exists actives]} {set actives 0}
  609.  
  610. # and, install a new 'winActive' patch , to 'activateHook':
  611.  
  612. proc activateHook name {
  613.     global winModes winActive
  614.     if {![info exists winModes($name)]} {
  615.         setWinMode $name
  616.     }
  617.     changeMode $winModes($name)
  618.  
  619.     if {[set ind [lsearch $winActive $name]] == -1} {
  620.         set winActive [linsert $winActive 0 $name]
  621.         return
  622.     }
  623.     if {$ind >= 1} {
  624.         set winActive [lreplace $winActive $ind $ind]
  625.         set winActive [linsert $winActive 0 $name]
  626.     }
  627.  
  628. }
  629.  
  630.  
  631. proc dirtyHook {name dirty} {
  632.     global winMenu
  633.     markMenuItem $winMenu [file tail $name] $dirty "◊"
  634. }
  635.  
  636.  
  637. set modifiedVars        {}
  638. set modifiedModeVars    {}
  639. set modifiedModeMenus    {}
  640.  
  641. proc quitHook {} {
  642.     global modifiedVars modifiedModeVars modifiedModeMenus modeMenus
  643.  
  644.     if {[llength $modifiedVars] || [llength $modifiedModeVars] || [llength $modifiedModeMenus]} {
  645.         if {[askyesno "Save changed flags/vars?"] == "yes"} {
  646.             foreach f [removeDups $modifiedModeMenus] {
  647.                 addUserLine "set modeMenus($f) \{$modeMenus($f)\}"
  648.             }
  649.             foreach f [removeDups $modifiedVars] {
  650.                 global $f
  651.                 addUserLine "set $f \"[set $f]\""
  652.             }
  653.             foreach f [removeDups $modifiedModeVars] {
  654.                 set nm [lindex $f 0]
  655.                 set mode [lindex $f 1]
  656.                 global $mode
  657.                 addUserLine "set [set mode]($nm) \"[set [set mode]($nm)]\""
  658.             }
  659.         }
  660.     }
  661. }
  662.  
  663.  
  664. #================================================================================
  665.  
  666. proc describeMode {} {
  667.     global mode modeSuffixes modeMenus modes
  668.     global ${mode}modeVars
  669.     
  670.     set text "\r\tMODE $mode\r\r"
  671.     set suffs ""
  672.     set first 1
  673.     foreach suf $modeSuffixes {
  674.         if {([llength $suf] == 3) && ([lindex $suf 1] == "winMode") && ([lindex $suf 2] == $mode)} {
  675.             if {$first} {
  676.                 lappend suffs $last
  677.                 set first 0
  678.             } else {
  679.                 append suffs ", $last"
  680.             }
  681.         }
  682.         set last $suf
  683.     }
  684.     append text "Mode suffixes: $suffs\r\r"
  685.     
  686.     set first 1
  687.     append text "Mode menus: "
  688.     if {[info exists modeMenus($mode)]} {
  689.         foreach m $modeMenus($mode) {
  690.             if $first {
  691.                 set first 0
  692.                 lappend text $m
  693.             } else {
  694.                 append text ", $m"
  695.             }
  696.         }
  697.     }
  698.     append text "\r\r"
  699.  
  700.     append text "Mode-specific variables:\r"
  701.     if {[info exists ${mode}modeVars]} {
  702.         foreach v [lsort [array names ${mode}modeVars]] {
  703.             append text [format "\t%-20s: \"%s\"\r" $v [set ${mode}modeVars($v)]]
  704.         }
  705.     }
  706.  
  707.  
  708.     set etext "\rMode-independent bindings:\r"
  709.     append text "\rMode-specific bindings:\r"
  710.     foreach b [split [bindingList] "\r"] {
  711.         set lst [lindex $b end]
  712.         if {$lst == $mode} {
  713.             append text "\t$b\r"
  714.         } elseif {[lsearch $modes $lst] < 0} {
  715.             append etext "\t$b\r"
  716.         }
  717.     }
  718.     new -n "* <$mode> MODE *"
  719.     insertText $text$etext
  720.     goto 0
  721.     
  722.     setWinInfo dirty 0
  723. }
  724.  
  725.  
  726.